names(herb) <- sort(unique(pca_scores$herb))
herb <- herb[c('Herbivore', 'Non-herbivore')]
pca_scores <- pca_scores[,-41]
Herb_disparity <- custom.subsets(pca_scores,group = herb)
Herb_disparity <- boot.matrix(Herb_disparity,bootstraps = 1000)
Herb_disparity <- dispRity(Herb_disparity,metric = c(sum,variances))
test.dispRity(Herb_disparity,test = wilcox.test,correction = 'bonferroni')
plot(Herb_disparity, col = c('darkolivegreen','firebrick'))
pca_scores <- as.data.frame(pca_scores_shapes)
bin_ranges <- read.table("bin_ranges_series.txt", header=T, row.names=1)
taxon_ages <- read.table ("taxon_ages_occlusal.txt", row.names=1, header=T)
taxon_ages <- as.data.frame(taxon_ages[rownames(pca_scores_shapes),])
time.bins <- list()
for (i in 1:length(rownames(bin_ranges))) {time.bins[[i]] <- rownames(taxon_ages)[which(taxon_ages$FAD > bin_ranges[i,"min.age"] & taxon_ages$LAD < bin_ranges[i,"max.age"])]}
names(time.bins) <- rownames(bin_ranges)
bin_PA <-  matrix(0, nrow=nrow(pca_scores_shapes), ncol=length(time.bins))
rownames(bin_PA) <- rownames(pca_scores_shapes)
for(x in 1:length(time.bins)) {
taxaInHere <- match(time.bins [[x]], rownames(bin_PA))
bin_PA[taxaInHere, x] <- 1
}
#H1
time <- as.data.frame(bin_PA)
pca_scores_data <- cbind(pca_scores,time)
group_data <- read.table("occ_group_synsaur_H1.txt", row.names=1, header=T)
pca_scores$H1_synsaur <- as.factor(group_data[,1])
dev.off()
dev.new()
par(mfrow=c(5,1), pin = c(2, 1))
plot(pca_scores_data[,1:2],
pch=c(21,22,22) [as.numeric(as.factor(pca_scores$H1_synsaur))],
bg=c('lightgoldenrod','chartreuse','deepskyblue') [as.numeric(as.factor(pca_scores$H1_synsaur))],
cex=ifelse(pca_scores_data$V5=='1',1.5,0),
)
abline(h = 0, col = rgb(0.5, 0.5, 0.5, 0.5), lty = 2, lwd = 1)
abline(v = 0, col = rgb(0.5, 0.5, 0.5, 0.5), lty = 2, lwd = 1)
plot(pca_scores_data[,1:2],
pch=c(21,22,22) [as.numeric(as.factor(pca_scores$H1_synsaur))],
bg=c('lightgoldenrod','chartreuse','deepskyblue') [as.numeric(as.factor(pca_scores$H1_synsaur))],
cex=ifelse(pca_scores_data$V4=='1',1.5,0),
)
abline(h = 0, col = rgb(0.5, 0.5, 0.5, 0.5), lty = 2, lwd = 1)
abline(v = 0, col = rgb(0.5, 0.5, 0.5, 0.5), lty = 2, lwd = 1)
plot(pca_scores_data[,1:2],
pch=c(21,22,22) [as.numeric(as.factor(pca_scores$H1_synsaur))],
bg=c('lightgoldenrod','chartreuse','deepskyblue') [as.numeric(as.factor(pca_scores$H1_synsaur))],
cex=ifelse(pca_scores_data$V3=='1',1.5,0),
)
abline(h = 0, col = rgb(0.5, 0.5, 0.5, 0.5), lty = 2, lwd = 1)
abline(v = 0, col = rgb(0.5, 0.5, 0.5, 0.5), lty = 2, lwd = 1)
plot(pca_scores_data[,1:2],
pch=c(21,22,22) [as.numeric(as.factor(pca_scores$H1_synsaur))],
bg=c('lightgoldenrod','chartreuse','deepskyblue') [as.numeric(as.factor(pca_scores$H1_synsaur))],
cex=ifelse(pca_scores_data$V2=='1',1.5,0),
)
abline(h = 0, col = rgb(0.5, 0.5, 0.5, 0.5), lty = 2, lwd = 1)
abline(v = 0, col = rgb(0.5, 0.5, 0.5, 0.5), lty = 2, lwd = 1)
plot(pca_scores_data[,1:2],
pch=c(21,22,22) [as.numeric(as.factor(pca_scores$H1_synsaur))],
bg=c('lightgoldenrod','chartreuse','deepskyblue') [as.numeric(as.factor(pca_scores$H1_synsaur))],
cex=ifelse(pca_scores_data$V1=='1',1.5,0),
)
abline(h = 0, col = rgb(0.5, 0.5, 0.5, 0.5), lty = 2, lwd = 1)
abline(v = 0, col = rgb(0.5, 0.5, 0.5, 0.5), lty = 2, lwd = 1)
#Disparity through time####
dev.off()
dev.new()
bin_ranges <- read.table("bin_ranges_series.txt", header=T, row.names=1)
bin_ranges
taxon_ages <- read.table ("taxon_ages_occlusal.txt", row.names=1, header=T)
taxon_ages
taxon_ages <- as.data.frame(taxon_ages[rownames(pca_scores_shapes),])
time.bins <- list()
for (i in 1:length(rownames(bin_ranges))) {time.bins[[i]] <- rownames(taxon_ages)[which(taxon_ages$FAD > bin_ranges[i,"min.age"] & taxon_ages$LAD < bin_ranges[i,"max.age"])]}
names(time.bins) <- rownames(bin_ranges)
time.bins
bin_PA <-  matrix(0, nrow=nrow(pca_scores_shapes), ncol=length(time.bins))
rownames(bin_PA) <- rownames(pca_scores_shapes)
bin_PA
for(x in 1:length(time.bins)) {
taxaInHere <- match(time.bins [[x]], rownames(bin_PA))
bin_PA[taxaInHere, x] <- 1
}
bin_PA #Useful overview of taxa per time bin
time.bins
sov_disparity <- DtT (pca_scores_shapes, bin_PA, 1000)
sov_results_mean <- sov_disparity$Variance[1,]
sov_results_lower <- c(sov_disparity$Variance[1,]- sov_disparity$Variance[2,])
sov_results_upper <- c(sov_disparity$Variance[1,] +sov_disparity$Variance[2,])
sov_results_final_time <- data.frame(sov_results_mean, sov_results_lower, sov_results_upper)
colnames(sov_results_final_time) <- c("mean","lower","upper")
rownames(sov_results_final_time) <- names(time.bins)
sov_results_final_time
results_plot <- sov_results_final_time
#Create limits which will denote the time bins
midpoints <- rowMeans(bin_ranges)
nbins <- nrow(bin_ranges)
# set-up the plotting area
layout (matrix (1:1, 2, 1))
upper.y <- 1.2 * max (results_plot [, "upper"])
lower.y <- 0.8 * min (results_plot [, "lower"])
upper.CI <- results_plot[, "upper"]
lower.CI <- results_plot [, "lower"]
x.limits <- c(max(bin_ranges), min(bin_ranges))
y.limits <- c(lower.y*1.1, upper.y*0.9 )
# plot empty graph with time bins
plot (midpoints, y = results_plot [, "mean"], xlim = x.limits, ylim = y.limits, col = "transparent", xlab = "age (Ma)", ylab = "Disparity (sum of variances)", cex=0.8)
# plot time slices as shaded area, this will have to be expanded upon if more time bins are added
polygon (c(358.9, 323.2, 323.2, 358.9), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(298.9, 273.01, 273.01, 298.9), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(259.51, 251.902,251.902, 259.51), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
abline(v=251.9)
abline(v=358.9)
# plot data
nbins<-nrow(bin_ranges)
polygon (c(midpoints, midpoints [nbins:1]), y = c(lower.CI, upper.CI [nbins:1]), border = NA, col = "lightblue")
lines (midpoints, y = results_plot [, "mean"])
points (midpoints, results_plot [, "mean"], pch = 21, col = "black", bg = "white", cex=1.3, lwd=1.4)
#Number of specimens per time bin #####
bin_alphadiversity <- colSums(bin_PA)
layout (matrix (1:1, 2, 1))
upper.y <- 40
lower.y <- 0
x.limits <- c(max(bin_ranges), min(bin_ranges))
y.limits <- c(lower.y*1, upper.y*1)
# plot empty graph with time bins
plot (midpoints, y = results_plot [, "mean"], xlim = x.limits, ylim = y.limits, col = "transparent", xlab = "age (Ma)", ylab = "No. specimens", cex=0.8)
# plot time slices as shaded area, this will have to be expanded upon if more time bins are added
polygon (c(358.9, 323.2, 323.2, 358.9), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(298.9, 273.01, 273.01, 298.9), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(259.51, 251.902,251.902, 259.51), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
abline(v=251.9)
abline(v=358.9)
lines (midpoints, y = bin_alphadiversity, lwd=2)
#Amniotes vs. non-amniotes (change H1 (base) to H2, H3 or H4)
group_data$Amniote <- read.table("occ_group_amniote_h1.txt", row.names = 1, header = TRUE)
bin_PA_df <- as.data.frame(bin_PA, stringsAsFactors = FALSE)
bin_PA_df$Amniote <- group_data$Amniote
bin_PA_amniote <- bin_PA_df %>% filter(Amniote != "Non-amniote")
bin_PA_amniote <- bin_PA_amniote[,-6]
bin_amniote <- colSums(bin_PA_amniote)
bin_PA_anamniote <- bin_PA_df %>% filter(Amniote != "Amniote")
bin_PA_anamniote <- bin_PA_anamniote[,-6]
bin_anamniote <- colSums(bin_PA_anamniote)
lines (midpoints, y = bin_amniote, lwd = 0.5)
lines (midpoints, y = bin_anamniote, lwd = 0.5, lty = 2)
dev.off()
dev.new()
bin_alphadiversity <- colSums(bin_PA)
layout (matrix (1:1, 2, 1))
upper.y <- 40
lower.y <- 0
x.limits <- c(max(bin_ranges), min(bin_ranges))
y.limits <- c(lower.y*1, upper.y*1)
# plot empty graph with time bins
plot (midpoints, y = results_plot [, "mean"], xlim = x.limits, ylim = y.limits, col = "transparent", xlab = "age (Ma)", ylab = "No. specimens", cex=0.8)
# plot time slices as shaded area, this will have to be expanded upon if more time bins are added
polygon (c(358.9, 323.2, 323.2, 358.9), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(298.9, 273.01, 273.01, 298.9), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(259.51, 251.902,251.902, 259.51), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
abline(v=251.9)
abline(v=358.9)
lines (midpoints, y = bin_alphadiversity, lwd=2)
#Amniotes vs. non-amniotes (change H1 (base) to H2, H3 or H4)
group_data$Amniote <- read.table("occ_group_amniote_h1.txt", row.names = 1, header = TRUE)
bin_PA_df <- as.data.frame(bin_PA, stringsAsFactors = FALSE)
bin_PA_df$Amniote <- group_data$Amniote
bin_PA_amniote <- bin_PA_df %>% filter(Amniote != "Non-amniote")
bin_PA_amniote <- bin_PA_amniote[,-6]
bin_amniote <- colSums(bin_PA_amniote)
bin_PA_anamniote <- bin_PA_df %>% filter(Amniote != "Amniote")
bin_PA_anamniote <- bin_PA_anamniote[,-6]
bin_anamniote <- colSums(bin_PA_anamniote)
lines (midpoints, y = bin_amniote, lwd = 0.5)
lines (midpoints, y = bin_anamniote, lwd = 0.5, lty = 2)
bin_alphadiversity <- colSums(bin_PA)
layout (matrix (1:1, 2, 1))
upper.y <- 40
lower.y <- 0
x.limits <- c(max(bin_ranges), min(bin_ranges))
y.limits <- c(lower.y*1, upper.y*1)
# plot empty graph with time bins
plot (midpoints, y = results_plot [, "mean"], xlim = x.limits, ylim = y.limits, col = "transparent", xlab = "age (Ma)", ylab = "No. specimens", cex=0.8)
# plot time slices as shaded area, this will have to be expanded upon if more time bins are added
polygon (c(358.9, 323.2, 323.2, 358.9), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(298.9, 273.01, 273.01, 298.9), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(259.51, 251.902,251.902, 259.51), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
abline(v=251.9)
abline(v=358.9)
lines (midpoints, y = bin_alphadiversity, lwd=2)
#Amniotes vs. non-amniotes (change H1 (base) to H2, H3 or H4)
group_data$Amniote <- read.table("occ_group_amniote_h2.txt", row.names = 1, header = TRUE)
bin_PA_df <- as.data.frame(bin_PA, stringsAsFactors = FALSE)
bin_PA_df$Amniote <- group_data$Amniote
bin_PA_amniote <- bin_PA_df %>% filter(Amniote != "Non-amniote")
bin_PA_amniote <- bin_PA_amniote[,-6]
bin_amniote <- colSums(bin_PA_amniote)
bin_PA_anamniote <- bin_PA_df %>% filter(Amniote != "Amniote")
bin_PA_anamniote <- bin_PA_anamniote[,-6]
bin_anamniote <- colSums(bin_PA_anamniote)
lines (midpoints, y = bin_amniote, lwd = 0.5)
lines (midpoints, y = bin_anamniote, lwd = 0.5, lty = 2)
bin_alphadiversity <- colSums(bin_PA)
layout (matrix (1:1, 2, 1))
upper.y <- 40
lower.y <- 0
x.limits <- c(max(bin_ranges), min(bin_ranges))
y.limits <- c(lower.y*1, upper.y*1)
# plot empty graph with time bins
plot (midpoints, y = results_plot [, "mean"], xlim = x.limits, ylim = y.limits, col = "transparent", xlab = "age (Ma)", ylab = "No. specimens", cex=0.8)
# plot time slices as shaded area, this will have to be expanded upon if more time bins are added
polygon (c(358.9, 323.2, 323.2, 358.9), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(298.9, 273.01, 273.01, 298.9), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(259.51, 251.902,251.902, 259.51), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
abline(v=251.9)
abline(v=358.9)
lines (midpoints, y = bin_alphadiversity, lwd=2)
#Amniotes vs. non-amniotes (change H1 (base) to H2, H3 or H4)
group_data$Amniote <- read.table("occ_group_amniote_h3.txt", row.names = 1, header = TRUE)
bin_PA_df <- as.data.frame(bin_PA, stringsAsFactors = FALSE)
bin_PA_df$Amniote <- group_data$Amniote
bin_PA_amniote <- bin_PA_df %>% filter(Amniote != "Non-amniote")
bin_PA_amniote <- bin_PA_amniote[,-6]
bin_amniote <- colSums(bin_PA_amniote)
bin_PA_anamniote <- bin_PA_df %>% filter(Amniote != "Amniote")
bin_PA_anamniote <- bin_PA_anamniote[,-6]
bin_anamniote <- colSums(bin_PA_anamniote)
lines (midpoints, y = bin_amniote, lwd = 0.5)
lines (midpoints, y = bin_anamniote, lwd = 0.5, lty = 2)
bin_alphadiversity <- colSums(bin_PA)
layout (matrix (1:1, 2, 1))
upper.y <- 40
lower.y <- 0
x.limits <- c(max(bin_ranges), min(bin_ranges))
y.limits <- c(lower.y*1, upper.y*1)
# plot empty graph with time bins
plot (midpoints, y = results_plot [, "mean"], xlim = x.limits, ylim = y.limits, col = "transparent", xlab = "age (Ma)", ylab = "No. specimens", cex=0.8)
# plot time slices as shaded area, this will have to be expanded upon if more time bins are added
polygon (c(358.9, 323.2, 323.2, 358.9), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(298.9, 273.01, 273.01, 298.9), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(259.51, 251.902,251.902, 259.51), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
abline(v=251.9)
abline(v=358.9)
lines (midpoints, y = bin_alphadiversity, lwd=2)
#Amniotes vs. non-amniotes (change H1 (base) to H2, H3 or H4)
group_data$Amniote <- read.table("occ_group_amniote_h4.txt", row.names = 1, header = TRUE)
bin_PA_df <- as.data.frame(bin_PA, stringsAsFactors = FALSE)
bin_PA_df$Amniote <- group_data$Amniote
bin_PA_amniote <- bin_PA_df %>% filter(Amniote != "Non-amniote")
bin_PA_amniote <- bin_PA_amniote[,-6]
bin_amniote <- colSums(bin_PA_amniote)
bin_PA_anamniote <- bin_PA_df %>% filter(Amniote != "Amniote")
bin_PA_anamniote <- bin_PA_anamniote[,-6]
bin_anamniote <- colSums(bin_PA_anamniote)
lines (midpoints, y = bin_amniote, lwd = 0.5)
lines (midpoints, y = bin_anamniote, lwd = 0.5, lty = 2)
partial.disparity <- function(X,groups){ #Partial disparity (as fraction)
centroid <- colMeans(X)
pd <- as.matrix(dist(rbind(X,centroid)))[1:nrow(X),-(1:ncol(X))]^2 / (nrow(X)-1)
sapply(split(pd,groups),sum)
}
partial.disparity.as.percentage <- function(X,groups){ #Partial disparity (as percentage)
centroid <- colMeans(X)
pd <- as.matrix(dist(rbind(X,centroid)))[1:nrow(X),-(1:ncol(X))]^2 / (nrow(X)-1)
sapply(split(pd,groups),sum)*100/sum(pd)
}
#Change H1 (base) to H2, H3 or H4
ages <- read.table("taxon_ages_occlusal.txt",sep="\t",head=TRUE)
epoch <- read.table("bin_ranges_series.txt",sep="\t",head=TRUE)
group_data <- read.table("occ_group_synsaur_h1.txt", row.names=1, header=T)
pca_scores$Clade <- as.factor(group_data[,1])
pd_through_t <- matrix(NA,nrow=nlevels(pca_scores$Clade),ncol=nrow(epoch)) #Clade partial disparity per time bin
pd_through_t_perc <- matrix(NA,nrow=nlevels(pca_scores$Clade),ncol=nrow(epoch))
rownames(pd_through_t) <- rownames(pd_through_t_perc) <- levels(pca_scores$Clade)
colnames(pd_through_t) <- colnames(pd_through_t_perc) <- epoch[,1]
for(i in seq_along(epoch$Stage)){
pca_scores_stage <- pca_scores[ages$FAD>=epoch$min.age[i]&ages$LAD<=epoch$max.age[i],] #Take any species that overlaps with the stage
pca_stage <- prcomp(pca_scores_stage[,1:40],scale. = T) #do a PCA just on those
pd_through_t_perc[,i] <- partial.disparity.as.percentage(pca_stage$x,pca_scores_stage$Clade)
}
pd_through_t_perc
stratplot <- function(xlim){
load("ics2023.Rdata")
plot(NA,xaxs="i",yaxs="i",xlim=xlim,ylim=c(0,3),ax=FALSE,ann=FALSE)
period <- ics[ics$Type=="Period",]
for(i in 1:nrow(period)){
rect(period$Start[i]/1e6,0,period$End[i]/1e6,1,col=period$Color[i])
text((period$Start[i]/1e6+period$End[i]/1e6)/2,.5,period$Name[i])
}
stage <- ics[ics$Type=="Stage",]
stage$Name <- gsub(" .+$","",stage$Name)
for(i in 1:nrow(stage)){
rect(stage$Start[i]/1e6,1,stage$End[i]/1e6,3,col=stage$Color[i])
text((stage$Start[i]/1e6+stage$End[i]/1e6)/2,2,stage$Name[i],cex=1,srt=90)
}
box(lwd=1.5)
axis(1,cex.axis=0.7,at=seq(0,350,1),labels=FALSE)
axis(1,cex.axis=0.7,at=seq(0,350,5),labels=FALSE,lwd=1.5)
axis(1,cex.axis=1,at=seq(0,350,10),lwd=1.5)
mtext("Age (Ma)",1,2.5,cex=1)
}
#Plots
cols <- c('lightgoldenrod','chartreuse','deepskyblue')
layout(matrix(1:2,ncol=1),height=c(2,1))
par(mar=c(0,5,1,5))
plot(NA,xlim=c(346.7,252.2),ylim=c(0,100),xaxs="i",yaxs="i",ann=FALSE,ax=FALSE)
pl <- cbind(c(100,0,0,0,0),pd_through_t_perc,pd_through_t_perc[,ncol(pd_through_t_perc)])
midp <- c(346.7,apply(epoch[,2:3],1,mean),252.2)
pl <- apply(pl,2,cumsum)
for(i in 1:nrow(pl)){
if(i==1){
polygon(c(midp,252.2,346.7),c(pl[i,],0,0),col=cols[i])
}else{
polygon(c(midp,rev(midp)),c(pl[i,],rev(pl[i-1,])),col=cols[i])
}
}
axis(2,at=c(0,25,50,75,100),labels=c("0","0.25","0.5","0.75","1"),las=2)
box(lwd=2)
par(mar=c(5,5,0,5))
stratplot(xlim=c(346.7,252.2))
partial.disparity <- function(X,groups){ #Partial disparity (as fraction)
centroid <- colMeans(X)
pd <- as.matrix(dist(rbind(X,centroid)))[1:nrow(X),-(1:ncol(X))]^2 / (nrow(X)-1)
sapply(split(pd,groups),sum)
}
partial.disparity.as.percentage <- function(X,groups){ #Partial disparity (as percentage)
centroid <- colMeans(X)
pd <- as.matrix(dist(rbind(X,centroid)))[1:nrow(X),-(1:ncol(X))]^2 / (nrow(X)-1)
sapply(split(pd,groups),sum)*100/sum(pd)
}
#Change H1 (base) to H2, H3 or H4
ages <- read.table("taxon_ages_occlusal.txt",sep="\t",head=TRUE)
epoch <- read.table("bin_ranges_series.txt",sep="\t",head=TRUE)
group_data <- read.table("occ_group_synsaur_h2.txt", row.names=1, header=T)
pca_scores$Clade <- as.factor(group_data[,1])
pd_through_t <- matrix(NA,nrow=nlevels(pca_scores$Clade),ncol=nrow(epoch)) #Clade partial disparity per time bin
pd_through_t_perc <- matrix(NA,nrow=nlevels(pca_scores$Clade),ncol=nrow(epoch))
rownames(pd_through_t) <- rownames(pd_through_t_perc) <- levels(pca_scores$Clade)
colnames(pd_through_t) <- colnames(pd_through_t_perc) <- epoch[,1]
for(i in seq_along(epoch$Stage)){
pca_scores_stage <- pca_scores[ages$FAD>=epoch$min.age[i]&ages$LAD<=epoch$max.age[i],] #Take any species that overlaps with the stage
pca_stage <- prcomp(pca_scores_stage[,1:40],scale. = T) #do a PCA just on those
pd_through_t_perc[,i] <- partial.disparity.as.percentage(pca_stage$x,pca_scores_stage$Clade)
}
pd_through_t_perc
stratplot <- function(xlim){
load("ics2023.Rdata")
plot(NA,xaxs="i",yaxs="i",xlim=xlim,ylim=c(0,3),ax=FALSE,ann=FALSE)
period <- ics[ics$Type=="Period",]
for(i in 1:nrow(period)){
rect(period$Start[i]/1e6,0,period$End[i]/1e6,1,col=period$Color[i])
text((period$Start[i]/1e6+period$End[i]/1e6)/2,.5,period$Name[i])
}
stage <- ics[ics$Type=="Stage",]
stage$Name <- gsub(" .+$","",stage$Name)
for(i in 1:nrow(stage)){
rect(stage$Start[i]/1e6,1,stage$End[i]/1e6,3,col=stage$Color[i])
text((stage$Start[i]/1e6+stage$End[i]/1e6)/2,2,stage$Name[i],cex=1,srt=90)
}
box(lwd=1.5)
axis(1,cex.axis=0.7,at=seq(0,350,1),labels=FALSE)
axis(1,cex.axis=0.7,at=seq(0,350,5),labels=FALSE,lwd=1.5)
axis(1,cex.axis=1,at=seq(0,350,10),lwd=1.5)
mtext("Age (Ma)",1,2.5,cex=1)
}
#Plots
cols <- c('lightgoldenrod','chartreuse','deepskyblue')
layout(matrix(1:2,ncol=1),height=c(2,1))
par(mar=c(0,5,1,5))
plot(NA,xlim=c(346.7,252.2),ylim=c(0,100),xaxs="i",yaxs="i",ann=FALSE,ax=FALSE)
pl <- cbind(c(100,0,0,0,0),pd_through_t_perc,pd_through_t_perc[,ncol(pd_through_t_perc)])
midp <- c(346.7,apply(epoch[,2:3],1,mean),252.2)
pl <- apply(pl,2,cumsum)
for(i in 1:nrow(pl)){
if(i==1){
polygon(c(midp,252.2,346.7),c(pl[i,],0,0),col=cols[i])
}else{
polygon(c(midp,rev(midp)),c(pl[i,],rev(pl[i-1,])),col=cols[i])
}
}
axis(2,at=c(0,25,50,75,100),labels=c("0","0.25","0.5","0.75","1"),las=2)
box(lwd=2)
par(mar=c(5,5,0,5))
stratplot(xlim=c(346.7,252.2))
partial.disparity <- function(X,groups){ #Partial disparity (as fraction)
centroid <- colMeans(X)
pd <- as.matrix(dist(rbind(X,centroid)))[1:nrow(X),-(1:ncol(X))]^2 / (nrow(X)-1)
sapply(split(pd,groups),sum)
}
partial.disparity.as.percentage <- function(X,groups){ #Partial disparity (as percentage)
centroid <- colMeans(X)
pd <- as.matrix(dist(rbind(X,centroid)))[1:nrow(X),-(1:ncol(X))]^2 / (nrow(X)-1)
sapply(split(pd,groups),sum)*100/sum(pd)
}
#Change H1 (base) to H2, H3 or H4
ages <- read.table("taxon_ages_occlusal.txt",sep="\t",head=TRUE)
epoch <- read.table("bin_ranges_series.txt",sep="\t",head=TRUE)
group_data <- read.table("occ_group_synsaur_h3.txt", row.names=1, header=T)
pca_scores$Clade <- as.factor(group_data[,1])
pd_through_t <- matrix(NA,nrow=nlevels(pca_scores$Clade),ncol=nrow(epoch)) #Clade partial disparity per time bin
pd_through_t_perc <- matrix(NA,nrow=nlevels(pca_scores$Clade),ncol=nrow(epoch))
rownames(pd_through_t) <- rownames(pd_through_t_perc) <- levels(pca_scores$Clade)
colnames(pd_through_t) <- colnames(pd_through_t_perc) <- epoch[,1]
for(i in seq_along(epoch$Stage)){
pca_scores_stage <- pca_scores[ages$FAD>=epoch$min.age[i]&ages$LAD<=epoch$max.age[i],] #Take any species that overlaps with the stage
pca_stage <- prcomp(pca_scores_stage[,1:40],scale. = T) #do a PCA just on those
pd_through_t_perc[,i] <- partial.disparity.as.percentage(pca_stage$x,pca_scores_stage$Clade)
}
pd_through_t_perc
stratplot <- function(xlim){
load("ics2023.Rdata")
plot(NA,xaxs="i",yaxs="i",xlim=xlim,ylim=c(0,3),ax=FALSE,ann=FALSE)
period <- ics[ics$Type=="Period",]
for(i in 1:nrow(period)){
rect(period$Start[i]/1e6,0,period$End[i]/1e6,1,col=period$Color[i])
text((period$Start[i]/1e6+period$End[i]/1e6)/2,.5,period$Name[i])
}
stage <- ics[ics$Type=="Stage",]
stage$Name <- gsub(" .+$","",stage$Name)
for(i in 1:nrow(stage)){
rect(stage$Start[i]/1e6,1,stage$End[i]/1e6,3,col=stage$Color[i])
text((stage$Start[i]/1e6+stage$End[i]/1e6)/2,2,stage$Name[i],cex=1,srt=90)
}
box(lwd=1.5)
axis(1,cex.axis=0.7,at=seq(0,350,1),labels=FALSE)
axis(1,cex.axis=0.7,at=seq(0,350,5),labels=FALSE,lwd=1.5)
axis(1,cex.axis=1,at=seq(0,350,10),lwd=1.5)
mtext("Age (Ma)",1,2.5,cex=1)
}
#Plots
cols <- c('lightgoldenrod','chartreuse','deepskyblue')
layout(matrix(1:2,ncol=1),height=c(2,1))
par(mar=c(0,5,1,5))
plot(NA,xlim=c(346.7,252.2),ylim=c(0,100),xaxs="i",yaxs="i",ann=FALSE,ax=FALSE)
pl <- cbind(c(100,0,0,0,0),pd_through_t_perc,pd_through_t_perc[,ncol(pd_through_t_perc)])
midp <- c(346.7,apply(epoch[,2:3],1,mean),252.2)
pl <- apply(pl,2,cumsum)
for(i in 1:nrow(pl)){
if(i==1){
polygon(c(midp,252.2,346.7),c(pl[i,],0,0),col=cols[i])
}else{
polygon(c(midp,rev(midp)),c(pl[i,],rev(pl[i-1,])),col=cols[i])
}
}
axis(2,at=c(0,25,50,75,100),labels=c("0","0.25","0.5","0.75","1"),las=2)
box(lwd=2)
par(mar=c(5,5,0,5))
stratplot(xlim=c(346.7,252.2))
partial.disparity <- function(X,groups){ #Partial disparity (as fraction)
centroid <- colMeans(X)
pd <- as.matrix(dist(rbind(X,centroid)))[1:nrow(X),-(1:ncol(X))]^2 / (nrow(X)-1)
sapply(split(pd,groups),sum)
}
partial.disparity.as.percentage <- function(X,groups){ #Partial disparity (as percentage)
centroid <- colMeans(X)
pd <- as.matrix(dist(rbind(X,centroid)))[1:nrow(X),-(1:ncol(X))]^2 / (nrow(X)-1)
sapply(split(pd,groups),sum)*100/sum(pd)
}
#Change H1 (base) to H2, H3 or H4
ages <- read.table("taxon_ages_occlusal.txt",sep="\t",head=TRUE)
epoch <- read.table("bin_ranges_series.txt",sep="\t",head=TRUE)
group_data <- read.table("occ_group_synsaur_h4.txt", row.names=1, header=T)
pca_scores$Clade <- as.factor(group_data[,1])
pd_through_t <- matrix(NA,nrow=nlevels(pca_scores$Clade),ncol=nrow(epoch)) #Clade partial disparity per time bin
pd_through_t_perc <- matrix(NA,nrow=nlevels(pca_scores$Clade),ncol=nrow(epoch))
rownames(pd_through_t) <- rownames(pd_through_t_perc) <- levels(pca_scores$Clade)
colnames(pd_through_t) <- colnames(pd_through_t_perc) <- epoch[,1]
for(i in seq_along(epoch$Stage)){
pca_scores_stage <- pca_scores[ages$FAD>=epoch$min.age[i]&ages$LAD<=epoch$max.age[i],] #Take any species that overlaps with the stage
pca_stage <- prcomp(pca_scores_stage[,1:40],scale. = T) #do a PCA just on those
pd_through_t_perc[,i] <- partial.disparity.as.percentage(pca_stage$x,pca_scores_stage$Clade)
}
pd_through_t_perc
stratplot <- function(xlim){
load("ics2023.Rdata")
plot(NA,xaxs="i",yaxs="i",xlim=xlim,ylim=c(0,3),ax=FALSE,ann=FALSE)
period <- ics[ics$Type=="Period",]
for(i in 1:nrow(period)){
rect(period$Start[i]/1e6,0,period$End[i]/1e6,1,col=period$Color[i])
text((period$Start[i]/1e6+period$End[i]/1e6)/2,.5,period$Name[i])
}
stage <- ics[ics$Type=="Stage",]
stage$Name <- gsub(" .+$","",stage$Name)
for(i in 1:nrow(stage)){
rect(stage$Start[i]/1e6,1,stage$End[i]/1e6,3,col=stage$Color[i])
text((stage$Start[i]/1e6+stage$End[i]/1e6)/2,2,stage$Name[i],cex=1,srt=90)
}
box(lwd=1.5)
axis(1,cex.axis=0.7,at=seq(0,350,1),labels=FALSE)
axis(1,cex.axis=0.7,at=seq(0,350,5),labels=FALSE,lwd=1.5)
axis(1,cex.axis=1,at=seq(0,350,10),lwd=1.5)
mtext("Age (Ma)",1,2.5,cex=1)
}
#Plots
cols <- c('lightgoldenrod','chartreuse','deepskyblue')
layout(matrix(1:2,ncol=1),height=c(2,1))
par(mar=c(0,5,1,5))
plot(NA,xlim=c(346.7,252.2),ylim=c(0,100),xaxs="i",yaxs="i",ann=FALSE,ax=FALSE)
pl <- cbind(c(100,0,0,0,0),pd_through_t_perc,pd_through_t_perc[,ncol(pd_through_t_perc)])
midp <- c(346.7,apply(epoch[,2:3],1,mean),252.2)
pl <- apply(pl,2,cumsum)
for(i in 1:nrow(pl)){
if(i==1){
polygon(c(midp,252.2,346.7),c(pl[i,],0,0),col=cols[i])
}else{
polygon(c(midp,rev(midp)),c(pl[i,],rev(pl[i-1,])),col=cols[i])
}
}
axis(2,at=c(0,25,50,75,100),labels=c("0","0.25","0.5","0.75","1"),las=2)
box(lwd=2)
par(mar=c(5,5,0,5))
stratplot(xlim=c(346.7,252.2))
